home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / FORTRAN2.LZH / UNTAB.FOR < prev    next >
Encoding:
Text File  |  1988-02-08  |  3.1 KB  |  121 lines
  1.       SUBROUTINE UNTAB ( STRING )
  2. C*
  3. C*                  *******************************
  4. C*                  *******************************
  5. C*                  **                           **
  6. C*                  **          UNTAB            **
  7. C*                  **                           **
  8. C*                  *******************************
  9. C*                  *******************************
  10. C*
  11. C*     SUBPROGRAM :
  12. C*          REMOVE TABS
  13. C*
  14. C*     AUTHOR :
  15. C*          ART RAGOSTA
  16. C*          MS 207-5
  17. C*          AMES RESEARCH CENTER
  18. C*          MOFFETT FIELD, CA  94035
  19. C*          (415) 694-5578
  20. C*
  21. C*     PURPOSE :
  22. C*          REPLACE A STRING WITH THE SAME STRING WHERE TABS ARE
  23. C*          REPLACED BY AN APPROPRIATE NUMBER OF BLANKS TO HAVE
  24. C*          SIMILAR SPACING.
  25. C*
  26. C*     INPUT ARGUMENTS :
  27. C*          STRING - STRING FROM WHICH TABS ARE TO BE REMOVED
  28. C*
  29. C*     OUTPUT ARGUMENTS :
  30. C*          STRING - SAME STRING WITH BLANKS REPLACING TABS(INPLACE)
  31. C*
  32. C*     INTERNAL WORK AREAS :
  33. C*          ITAB - AN ARRAY CONTAINING THE TAB STOP SETTINGS.
  34. C*          LINE - TEMPORARY STORAGE FOR TABBED STRING.
  35. C*
  36. C*     COMMON BLOCKS :
  37. C*          NONE
  38. C*
  39. C*     FILE REFERENCES :
  40. C*          NONE
  41. C*
  42. C*     DATA BASE ACCESS :
  43. C*          NONE
  44. C*
  45. C*     SUBPROGRAM REFERENCES :
  46. C*          NONE
  47. C*
  48. C*     ERROR PROCESSING :
  49. C*          NONE
  50. C*
  51. C*     TRANSPORTABILITY LIMITATIONS :
  52. C*          THE NON-STANDARD DATA STATEMENT SETS TAB CHARACTER TO ASCII 9.
  53. C*          ( TRANSPORTABLE VERSION IS COMMENTED )
  54. C*
  55. C*     ASSUMPTIONS AND RESTRICTIONS :
  56. C*          NONE
  57. C*
  58. C*     LANGUAGE AND COMPILER :
  59. C*          ANSI FORTRAN 77
  60. C*
  61. C*     VERSION AND DATE :
  62. C*          VERSION I.1     29-july-1985
  63. C*
  64. C*     CHANGE HISTORY :
  65. C*          29-JUL-85    ITPTR FIXED (INITIALIZED)
  66. C*          15-OCT-84    INITIAL VERSION
  67. C*
  68. C***********************************************************************
  69. C*
  70.       CHARACTER *(*) STRING
  71.       CHARACTER *255 LINE
  72.       CHARACTER *1 TAB
  73.       DIMENSION ITAB(32)
  74.       DATA ITAB / 9, 17, 25, 33, 41, 49, 57, 65, 73, 81, 89, 98, 106,
  75.      $  114, 122, 130, 138, 146, 154, 162, 170, 178, 186, 195, 203,
  76.      $  211, 219, 227, 235, 243, 251, 10000 /
  77. C
  78. C --- NON-STANDARD DATA STATEMENT :
  79. C
  80.       DATA TAB/9/
  81. C
  82. C --- STANDARD REPLACEMENT FOR ABOVE DATA STATEMENT :
  83. C     TAB = CHAR ( 9 )
  84. C
  85.       LINE   = STRING
  86.       STRING = ' '
  87.       L      = LENGTH(LINE)
  88.       LL     = LEN(STRING)
  89.       K      = 1
  90.       ITPTR  = 1
  91.       DO 20 I = 1,L
  92.           IF ( LINE(I:I) .EQ. TAB ) THEN
  93. C
  94. C ------ FIND NEXT TAB STOP
  95. C
  96. 5            IF ( K .GE. ITAB(ITPTR)) THEN
  97.                 ITPTR = ITPTR + 1
  98.                 GO TO 5
  99.              ENDIF
  100. C
  101. C ------ SKIP BLANKS TO TAB STOP ( ALREADY BEEN INITIALIZED TO BLANKS )
  102. C
  103. 10           IF ( K .LT. ITAB(ITPTR)) THEN
  104.                 K = K + 1
  105.                 GO TO 10
  106.              ENDIF
  107.           ELSE
  108. C
  109. C ------ COPY NON-TAB CHARACTERS
  110. C
  111.              STRING(K:K) = LINE(I:I)
  112.              K = K + 1
  113.           ENDIF
  114.           IF ( K .GT. LL ) RETURN
  115. 20        CONTINUE
  116.       RETURN
  117.       END
  118. C
  119. C---END UNTAB
  120. C
  121.